(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower Abbrevia
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1997-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)

 {*********************************************************}
 {* ABBREVIA: AbDfCryS.pas 3.05                           *}
 {*********************************************************}
 {* Deflate encryption streams                            *}
 {*********************************************************}

unit AbDfCryS;

{$I AbDefine.inc}

interface

uses
  SysUtils,
  Classes;

type
  TAbZipEncryptHeader = array [0..11] of byte;

  TAbZipDecryptEngine = class
  private
    FReady: boolean;
    FState: array [0..2] of longint;
  protected
    procedure zdeInitState(const aPassphrase: string);
  public
    constructor Create;

    function Decode(aCh: byte): byte;
    {-decodes a byte}
    procedure DecodeBuffer(var aBuffer; aCount: integer);
    {-decodes a buffer}

    function VerifyHeader(const aHeader: TAbZipEncryptHeader;
      const aPassphrase: string;
      aCheckValue: longint): boolean;
    {-validate an encryption header}
  end;

  TAbDfDecryptStream = class(TStream)
  private
    FCheckValue: longint;
    FEngine: TAbZipDecryptEngine;
    FPassphrase: string;
    FReady:  boolean;
    FStream: TStream;
  protected
  public
    constructor Create(aStream: TStream;
      aCheckValue: longint;
      const aPassphrase: string);
    destructor Destroy; override;                            {!!.02}

    function IsValid: boolean;

    function Read(var aBuffer; aCount: longint): longint; override;
    function Seek(aOffset: longint; aOrigin: word): longint; override;
    function Write(const aBuffer; aCount: longint): longint; override;
  end;

  TAbZipEncryptEngine = class
  private
    FReady: boolean;
    FState: array [0..2] of longint;
  protected
    procedure zeeInitState(const aPassphrase: string);
  public
    constructor Create;

    function Encode(aCh: byte): byte;
    {-encodes a byte}
    procedure EncodeBuffer(var aBuffer; aCount: integer);
    {-encodes a buffer}

    procedure CreateHeader(var aHeader: TAbZipEncryptHeader;
      const aPassphrase: string;
      aCheckValue: longint);
    {-generate an encryption header}
  end;

  TAbDfEncryptStream = class(TStream)
  private
    FBuffer:  PAnsiChar;
    FBufSize: integer;
    FEngine:  TAbZipEncryptEngine;
    FStream:  TStream;
  protected
  public
    constructor Create(aStream: TStream;
      aCheckValue: longint;
      const aPassphrase: string);
    destructor Destroy; override;

    function Read(var aBuffer; aCount: longint): longint; override;
    function Seek(aOffset: longint; aOrigin: word): longint; override;
    function Write(const aBuffer; aCount: longint): longint; override;
  end;

implementation

{Notes: the ZIP spec defines a couple of primitive routines for
        performing encryption. For speed Abbrevia inlines them into
        the respective methods of the encryption/decryption engines

        char crc32(long,char)
          return updated CRC from current CRC and next char

        update_keys(char):
          Key(0) <- crc32(key(0),char)
          Key(1) <- Key(1) + (Key(0) & 000000ffH)
          Key(1) <- Key(1) * 134775813 + 1
          Key(2) <- crc32(key(2),key(1) >> 24)
        end update_keys

        char decrypt_byte()
          local unsigned short temp
          temp <- Key(2) | 2
          decrypt_byte <- (temp * (temp ^ 1)) >> 8
        end decrypt_byte
}

uses
  AbUtils;

{---magic numbers from ZIP spec---}
const
  StateInit1  = 305419896;
  StateInit2  = 591751049;
  StateInit3  = 878082192;
  MagicNumber = 134775813;

{===internal encryption class========================================}
constructor TAbZipDecryptEngine.Create;
begin
  {create the ancestor}
  inherited Create;

  {we're not ready for decryption yet since a header hasn't been
   properly verified with VerifyHeader}
  FReady := False;
end;

{--------}
function TAbZipDecryptEngine.Decode(aCh: byte): byte;
var
  Temp: longint;
begin
  {check for programming error}
  Assert(FReady,
    'TAbZipDecryptEngine.Decode: must successfully call VerifyHeader first');

  {calculate the decoded byte (uses inlined decrypt_byte)}
  Temp := (FState[2] and $FFFF) or 2;
  Result := aCh xor ((Temp * (Temp xor 1)) shr 8);

  {mix the decoded byte into the state (uses inlined update_keys)}
  FState[0] := AbUpdateCrc32(Result, FState[0]);
  FState[1] := FState[1] + (FState[0] and $FF);
  FState[1] := (FState[1] * MagicNumber) + 1;
  FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);
end;

{--------}
procedure TAbZipDecryptEngine.DecodeBuffer(var aBuffer; aCount: integer);
var
  i: integer;
  Temp: longint;
  Buffer: PAnsiChar;
  WorkState: array [0..2] of longint;
begin
  {check for programming error}
  Assert(FReady,
    'TAbZipDecryptEngine.Decode: must successfully call VerifyHeader first');

  {move the state to a local variable--for better speed}
  WorkState[0] := FState[0];
  WorkState[1] := FState[1];
  WorkState[2] := FState[2];

  {reference the buffer as a PChar--easier arithmetic}
  Buffer := @aBuffer;

  {for each byte in the buffer...}
  for i := 0 to pred(aCount) do
  begin

    {calculate the next decoded byte (uses inlined decrypt_byte)}
    Temp := (WorkState[2] and $FFFF) or 2;
    Buffer^ := AnsiChar(byte(Buffer^) xor
      ((Temp * (Temp xor 1)) shr 8));

    {mix the decoded byte into the state (uses inlined update_keys)}
    WorkState[0] := AbUpdateCrc32(byte(Buffer^), WorkState[0]);
    WorkState[1] := WorkState[1] + (WorkState[0] and $FF);
    WorkState[1] := (WorkState[1] * MagicNumber) + 1;
    WorkState[2] := AbUpdateCrc32(WorkState[1] shr 24, WorkState[2]);

    {move onto the next byte}
    Inc(Buffer);
  end;

  {save the state}
  FState[0] := WorkState[0];
  FState[1] := WorkState[1];
  FState[2] := WorkState[2];
end;

{--------}
function TAbZipDecryptEngine.VerifyHeader(const aHeader: TAbZipEncryptHeader;
  const aPassphrase: string;
  aCheckValue: longint): boolean;
type
  TLongAsBytes = packed record
    L1, L2, L3, L4: byte
  end;
var
  i: integer;
  Temp: longint;
  WorkHeader: TAbZipEncryptHeader;
begin
  {check for programming errors}
  Assert(aPassphrase <> '',
    'TAbZipDecryptEngine.VerifyHeader: need a passphrase');

  {initialize the decryption state}
  zdeInitState(aPassphrase);

  {decrypt the bytes in the header}
  for i := 0 to 11 do
  begin

    {calculate the next decoded byte (uses inlined decrypt_byte)}
    Temp := (FState[2] and $FFFF) or 2;
    WorkHeader[i] := aHeader[i] xor ((Temp * (Temp xor 1)) shr 8);

    {mix the decoded byte into the state (uses inlined update_keys)}
    FState[0] := AbUpdateCrc32(WorkHeader[i], FState[0]);
    FState[1] := FState[1] + (FState[0] and $FF);
    FState[1] := (FState[1] * MagicNumber) + 1;
    FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);
  end;

  {the header is valid if the twelfth byte of the decrypted header
   equals the fourth byte of the check value}
  Result := WorkHeader[11] = TLongAsBytes(aCheckValue).L4;

  {note: zips created with PKZIP prior to version 2.0 also checked
         that the tenth byte of the decrypted header equals the third
         byte of the check value}
  FReady := Result;
end;

{--------}
procedure TAbZipDecryptEngine.zdeInitState(const aPassphrase: string);
var
  i: integer;
begin
  {initialize the decryption state}
  FState[0] := StateInit1;
  FState[1] := StateInit2;
  FState[2] := StateInit3;

  {mix in the passphrase to the state (uses inlined update_keys)}
  for i := 1 to length(aPassphrase) do
  begin
    FState[0] := AbUpdateCrc32(byte(aPassphrase[i]), FState[0]);
    FState[1] := FState[1] + (FState[0] and $FF);
    FState[1] := (FState[1] * MagicNumber) + 1;
    FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);
  end;
end;

{====================================================================}


{====================================================================}
constructor TAbDfDecryptStream.Create(aStream: TStream;
  aCheckValue: longint;
  const aPassphrase: string);
begin
  {create the ancestor}
  inherited Create;

  {save the parameters}
  FStream := aStream;
  FCheckValue := aCheckValue;
  FPassphrase := aPassphrase;

  {create the decryption engine}
  FEngine := TAbZipDecryptEngine.Create;
end;

{--------}
destructor TAbDfDecryptStream.Destroy;                     {new !!.02}
begin
  FEngine.Free;
  inherited Destroy;
end;

{--------}
function TAbDfDecryptStream.IsValid: boolean;
var
  Header: TAbZipEncryptHeader;
begin
  {read the header from the stream}
  FStream.ReadBuffer(Header, sizeof(Header));

  {check to see if the decryption engine agrees it's valid}
  Result := FEngine.VerifyHeader(Header, FPassphrase, FCheckValue);

  {if it isn't valid, reposition the stream, ready for the next try}
  if not Result then
  begin
    FStream.Seek(-sizeof(Header), soFromCurrent);
    FReady := False;
  end

  {otherwise, the stream is ready for decrypting data}
  else
    FReady := True;
end;

{--------}
function TAbDfDecryptStream.Read(var aBuffer; aCount: longint): longint;
begin
  {check for programming error}
  Assert(FReady,
    'TAbDfDecryptStream.Read: the stream header has not been verified');

  {read the data from the underlying stream}
  Result := FStream.Read(aBuffer, aCount);

  {decrypt the data}
  FEngine.DecodeBuffer(aBuffer, Result);
end;

{--------}
function TAbDfDecryptStream.Seek(aOffset: longint; aOrigin: word): longint;
begin
  Result := FStream.Seek(aOffset, aOrigin);
end;

{--------}
function TAbDfDecryptStream.Write(const aBuffer; aCount: longint): longint;
begin
  {check for programming error}
  Assert(False,
    'TAbDfDecryptStream.Write: the stream is read-only');
  Result := 0;
end;

{====================================================================}


{===TAbZipEncryptEngine==============================================}
constructor TAbZipEncryptEngine.Create;
begin
  {create the ancestor}
  inherited Create;

  {we're not ready for encryption yet since a header hasn't been
   properly generated with CreateHeader}
  FReady := False;
end;

{--------}
procedure TAbZipEncryptEngine.CreateHeader(
  var aHeader: TAbZipEncryptHeader;
  const aPassphrase: string;
  aCheckValue: longint);
type
  TLongAsBytes = packed record
    L1, L2, L3, L4: byte
  end;
var
  Ch: byte;
  i:  integer;
  Temp: longint;
  WorkHeader: TAbZipEncryptHeader;
begin
  {check for programming errors}
  Assert(aPassphrase <> '',
    'TAbZipEncryptEngine.CreateHeader: need a passphrase');

  {set the first ten bytes of the header with random values (in fact,
   we use a random value for each byte and mix it in with the state)}

  {initialize the decryption state}
  zeeInitState(aPassphrase);

  {for the first ten bytes...}
  for i := 0 to 9 do
  begin

    {get a random value}
    Ch := Random(256);

    {calculate the XOR encoding byte (uses inlined decrypt_byte)}
    Temp := (FState[2] and $FFFF) or 2;
    Temp := (Temp * (Temp xor 1)) shr 8;

    {mix the unencoded byte into the state (uses inlined update_keys)}
    FState[0] := AbUpdateCrc32(Ch, FState[0]);
    FState[1] := FState[1] + (FState[0] and $FF);
    FState[1] := (FState[1] * MagicNumber) + 1;
    FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);

    {set the current byte of the header}
    WorkHeader[i] := Ch xor Temp;
  end;

  {now encrypt the first ten bytes of the header (this merely sets up
   the state so that we can encrypt the last two bytes)}

  {reinitialize the decryption state}
  zeeInitState(aPassphrase);

  {for the first ten bytes...}
  for i := 0 to 9 do
  begin

    {calculate the XOR encoding byte (uses inlined decrypt_byte)}
    Temp := (FState[2] and $FFFF) or 2;
    Temp := (Temp * (Temp xor 1)) shr 8;

    {mix the unencoded byte into the state (uses inlined update_keys)}
    FState[0] := AbUpdateCrc32(WorkHeader[i], FState[0]);
    FState[1] := FState[1] + (FState[0] and $FF);
    FState[1] := (FState[1] * MagicNumber) + 1;
    FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);

    {set the current byte of the header}
    WorkHeader[i] := WorkHeader[i] xor Temp;
  end;

  {now initialize byte 10 of the header, and encrypt it}
  Ch := TLongAsBytes(aCheckValue).L3;
  Temp := (FState[2] and $FFFF) or 2;
  Temp := (Temp * (Temp xor 1)) shr 8;
  FState[0] := AbUpdateCrc32(Ch, FState[0]);
  FState[1] := FState[1] + (FState[0] and $FF);
  FState[1] := (FState[1] * MagicNumber) + 1;
  FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);
  WorkHeader[10] := Ch xor Temp;

  {now initialize byte 11 of the header, and encrypt it}
  Ch := TLongAsBytes(aCheckValue).L4;
  Temp := (FState[2] and $FFFF) or 2;
  Temp := (Temp * (Temp xor 1)) shr 8;
  FState[0] := AbUpdateCrc32(Ch, FState[0]);
  FState[1] := FState[1] + (FState[0] and $FF);
  FState[1] := (FState[1] * MagicNumber) + 1;
  FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);
  WorkHeader[11] := Ch xor Temp;

  {we're now ready to encrypt}
  FReady := True;

  {return the header}
  aHeader := WorkHeader;
end;

{--------}
function TAbZipEncryptEngine.Encode(aCh: byte): byte;
var
  Temp: longint;
begin
  {check for programming error}
  Assert(FReady,
    'TAbZipEncryptEngine.Encode: must call CreateHeader first');

  {calculate the encoded byte (uses inlined decrypt_byte)}
  Temp := (FState[2] and $FFFF) or 2;
  Result := aCh xor (Temp * (Temp xor 1)) shr 8;

  {mix the unencoded byte into the state (uses inlined update_keys)}
  FState[0] := AbUpdateCrc32(aCh, FState[0]);
  FState[1] := FState[1] + (FState[0] and $FF);
  FState[1] := (FState[1] * MagicNumber) + 1;
  FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);
end;

{--------}
procedure TAbZipEncryptEngine.EncodeBuffer(var aBuffer; aCount: integer);
var
  Ch: byte;
  i:  integer;
  Temp: longint;
  Buffer: PAnsiChar;
  WorkState: array [0..2] of longint;
begin
  {check for programming error}
  Assert(FReady,
    'TAbZipEncryptEngine.EncodeBuffer: must call CreateHeader first');

  {move the state to a local variable--for better speed}
  WorkState[0] := FState[0];
  WorkState[1] := FState[1];
  WorkState[2] := FState[2];

  {reference the buffer as a PChar--easier arithmetic}
  Buffer := @aBuffer;

  {for each byte in the buffer...}
  for i := 0 to pred(aCount) do
  begin

    {calculate the next encoded byte (uses inlined decrypt_byte)}
    Temp := (WorkState[2] and $FFFF) or 2;
    Ch := byte(Buffer^);
    Buffer^ := AnsiChar(Ch xor ((Temp * (Temp xor 1)) shr 8));

    {mix the decoded byte into the state (uses inlined update_keys)}
    WorkState[0] := AbUpdateCrc32(Ch, WorkState[0]);
    WorkState[1] := WorkState[1] + (WorkState[0] and $FF);
    WorkState[1] := (WorkState[1] * MagicNumber) + 1;
    WorkState[2] := AbUpdateCrc32(WorkState[1] shr 24, WorkState[2]);

    {move onto the next byte}
    Inc(Buffer);
  end;

  {save the state}
  FState[0] := WorkState[0];
  FState[1] := WorkState[1];
  FState[2] := WorkState[2];
end;

{--------}
procedure TAbZipEncryptEngine.zeeInitState(const aPassphrase: string);
var
  i: integer;
begin
  {initialize the decryption state}
  FState[0] := StateInit1;
  FState[1] := StateInit2;
  FState[2] := StateInit3;

  {mix in the passphrase to the state (uses inlined update_keys)}
  for i := 1 to length(aPassphrase) do
  begin
    FState[0] := AbUpdateCrc32(byte(aPassphrase[i]), FState[0]);
    FState[1] := FState[1] + (FState[0] and $FF);
    FState[1] := (FState[1] * MagicNumber) + 1;
    FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);
  end;
end;

{====================================================================}


{===TAbDfEncryptStream===============================================}
constructor TAbDfEncryptStream.Create(aStream: TStream;
  aCheckValue: longint;
  const aPassphrase: string);
var
  Header: TAbZipEncryptHeader;
begin
  {create the ancestor}
  inherited Create;

  {save the stream parameter}
  FStream := aStream;

  {create the encryption engine}
  FEngine := TAbZipEncryptEngine.Create;

  {generate the encryption header, write it to the stream}
  FEngine.CreateHeader(Header, aPassphrase, aCheckValue);
  aStream.WriteBuffer(Header, sizeof(Header));
end;

{--------}
destructor TAbDfEncryptStream.Destroy;
begin
  {free the internal buffer if used}
  if (FBuffer <> nil) then
    FreeMem(FBuffer);

  {free the engine}
  FEngine.Free;                                                {!!.02}

  {destroy the ancestor}
  inherited Destroy;
end;

{--------}
function TAbDfEncryptStream.Read(var aBuffer; aCount: longint): longint;
begin
  {check for programming error}
  Assert(False,
    'TAbDfEncryptStream.Read: the stream is write-only');
  Result := 0;
end;

{--------}
function TAbDfEncryptStream.Seek(aOffset: longint; aOrigin: word): longint;
begin
  Result := FStream.Seek(aOffset, aOrigin);
end;

{--------}
function TAbDfEncryptStream.Write(const aBuffer; aCount: longint): longint;
begin
  {note: since we cannot alter a const parameter, we should copy the
         data to our own buffer, encrypt it and then write it}

  {check that our buffer is large enough}
  if (FBufSize < aCount) then
  begin
    if (FBuffer <> nil) then
      FreeMem(FBuffer);
    GetMem(FBuffer, aCount);
    FBufSize := aCount;
  end;

  {copy the data to our buffer}
  Move(aBuffer, FBuffer^, aCount);

  {encrypt the data in our buffer}
  FEngine.EncodeBuffer(FBuffer^, aCount);

  {write the data in our buffer to the underlying stream}
  Result := FStream.Write(FBuffer^, aCount);
end;

{====================================================================}


end.
